home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Network Support Library
/
RoseWare - Network Support Library.iso
/
apidev
/
flagbi.arc
/
ENGINE.PAS
next >
Wrap
Pascal/Delphi Source File
|
1989-10-10
|
6KB
|
211 lines
unit Engine;
{******************************************************}
{* SEARCH ENGINE *}
{* Input Parameters: *}
{* Mask : The file specification to search for *}
{* May contain wildcards. *}
{* Attr : File attribute to search for *}
{* Proc : Procedure to process each found file *}
{* *}
{* Output Parameters: *}
{* ErrorCode : Contains the final error code *}
{* *}
{*This idea borrowed from Dr. Dobbs, Modified slightly*}
{*By Azatar MicroSystems, Inc. *}
{******************************************************}
(* All software is copyrighted by Azatar MicroSystems *)
(* and Lee Drake. Code for this example may be copied *)
(* for non-commercial applications as long as this notice *)
(* is included in the header. All commercial use is *)
(* specifically excluded. *)
interface
uses
dos;
type
proctype = procedure(var s : searchrec; p : pathstr);
proctype2 = procedure(var s : searchrec; p, origpath, np : pathstr);
fullnamestr = string[12];
procedure searchengine ( mask : pathstr;
attr : byte;
proc : proctype;
var errorcode : byte);
procedure new_searchengine ( mask : pathstr;
attr : byte;
proc : proctype2;
newp : pathstr;
var errorcode : byte);
function gooddirectory (s : searchrec) : boolean;
procedure shrinkpath (var path : pathstr);
Procedure SEARCHerrormessage (errcode : byte);
procedure searchengineall ( path : pathstr;
mask : fullnamestr;
attr : byte;
proc : proctype;
var errorcode : byte);
implementation
var
enginemask : fullnamestr;
engineattr : byte;
engineproc : proctype;
enginecode : byte;
{*********************************************************}
procedure searchengine ( mask : pathstr;
attr : byte;
proc : proctype;
var errorcode : byte);
var
s : searchrec;
p : pathstr;
ext : extstr;
begin
{$V-}
fsplit(mask,p,mask,ext);
{$v+}
mask := mask + ext;
findfirst(p + mask, attr, s);
if doserror <> 0 then
begin
errorcode := doserror;
exit;
end;
while doserror = 0 do
begin
proc(s,p);
findnext(s);
end;
if doserror = 18 then
errorcode := 0
else
errorcode := doserror;
end; { of procedure }
{*********************************************************}
procedure new_searchengine ( mask : pathstr;
attr : byte;
proc : proctype2;
newp : pathstr;
var errorcode : byte);
var
s : searchrec;
p : pathstr;
ext : extstr;
TEMPMSK : PATHSTR;
begin
TEMPMSK := MASK;
{$v-}
fsplit(mask,p,mask,ext);
{$v+}
mask := mask + ext;
findfirst(p + mask, attr, s);
if doserror <> 0 then
begin
errorcode := doserror;
exit;
end;
while doserror = 0 do
begin
proc(s,p,TEMPmsk,newp);
findnext(s);
end;
if doserror = 18 then
errorcode := 0
else
errorcode := doserror;
end; { of procedure }
{*********************************************************}
function gooddirectory (s : searchrec) : boolean;
begin
gooddirectory := (s.name <> '.') and
(s.name <> '..') and
(s.attr and directory = directory);
end;
{*********************************************************}
procedure shrinkpath (var path : pathstr);
var
p : byte;
dummy : namestr;
begin
{$v-}
fsplit(path, path, dummy, dummy);
{$v+}
dec(path[0]);
end;
{*********************************************************}
{$f+} procedure searchonedir ( var s : searchrec; p : pathstr ); {$f-}
{ recursive procedure to search one directory }
begin
if gooddirectory(s) then
begin
p := p + s.name;
searchengine(p + '\' + enginemask, engineattr,
engineproc, enginecode);
searchengine(p + '\*.*', directory or archive,
searchonedir, enginecode);
end;
end;
{*********************************************************}
procedure searchengineall ( path : pathstr;
mask : fullnamestr;
attr : byte;
proc : proctype;
var errorcode : byte);
begin
(* Set up unit global variables for use in
recursive directory search propcedure *)
enginemask := mask;
engineproc := proc;
engineattr := attr;
searchengine(path + mask, attr, proc, errorcode);
searchengine(path + '*.*', directory or attr, searchonedir, errorcode);
errorcode := enginecode;
end;
{*********************************************************}
procedure SEARCHerrormessage (errcode : byte);
begin
case errcode of
0 : ; { ok - no error }
2 : writeln('file not found');
3 : writeln('path not found');
5 : writeln('access denied');
6 : writeln('invalid handle');
8 : writeln('not enough memory');
10 : writeln('invalid environment');
11 : writeln('invalid format');
18 : ; { ok - merely no more files }
else
writeln('error #',errcode);
end;
end;
begin
end.